home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / drives.swg / 0027_FCBLABELS - Disk Serial.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-17  |  6.4 KB  |  253 lines
  1. UNIT FCBLabel;
  2. {Turbo Pascal unit for manipulating volume labels}
  3.  
  4. INTERFACE
  5. USES
  6.     DOS;
  7. TYPE
  8.     DriveType   = String[1];
  9.     DiskIDType  = String[11];
  10.  
  11. FUNCTION GetDiskID(Drive:DriveType): DiskIDType;
  12. FUNCTION SetDiskID(Drive:DriveType;
  13.                     DiskID:DiskIDType): Boolean;
  14. FUNCTION ReNameDiskID(Drive:DriveType;
  15.                    OldDiskID:DiskIDType;
  16.                    NewDiskID:DiskIDType): Boolean;
  17. FUNCTION DeleteDiskID(Drive:DriveType): Boolean;
  18.  
  19. IMPLEMENTATION
  20. TYPE
  21.     ExtendedFCBRecord = RECORD
  22.                ExtFCB : Byte;
  23.                Res1   : ARRAY[1..5] OF Byte;
  24.                Attr   : Byte;
  25.                Drive  : Byte;
  26.                Name1  : ARRAY[1..11] OF Char;
  27.                Unused1: ARRAY[1..5] OF Char;
  28.                Name2  : ARRAY[1..11] OF Char;
  29.                Unused2: ARRAY[1..9] OF Byte;
  30.            END;
  31.  
  32. FUNCTION GetDiskID(Drive:DriveType): DiskIDType;
  33. VAR
  34.    DirInfo     : SearchRec;
  35.    DirDiskID   : String[12];
  36.    I,PosPeriod : Byte;
  37. BEGIN
  38.    FindFirst(Drive+':\'+'*.*',VolumeID,DirInfo);
  39.    IF DosError = 0 THEN
  40.       BEGIN
  41.          DirDiskID := DirInfo.Name;
  42.          PosPeriod := POS('.',DirDiskID);
  43.          IF PosPeriod > 0 THEN
  44.             Delete(DirDiskID,PosPeriod,1);
  45.          GetDiskID := DirDiskID
  46.       END
  47.    ELSE
  48.       GetDiskID := ''
  49. END;
  50.  
  51. {Use MsDos service 16H to SET a volume label }
  52. FUNCTION SetDiskID(Drive:DriveType;
  53.                     DiskID:DiskIDType): Boolean;
  54. VAR
  55.    FCB  : ExtendedFCBRecord;
  56.    Regs : Registers;
  57.    Temp : String[1];
  58.    I    : Integer;
  59. BEGIN
  60.    Temp := Drive;
  61.    WITH FCB DO
  62.      BEGIN
  63.        ExtFCB := $FF;
  64.        Attr   := $8;
  65.        Drive  := Ord(UpCase(Temp[1])) - 64;
  66.        FOR I := 1 TO Length(DiskID) DO
  67.          Name1[I] := DiskID[I];
  68.          IF Length(DiskID) < 11 THEN
  69.            FOR I := (Length(DiskID) + 1) TO 11 DO
  70.              Name1[I] := ' '
  71.      END;
  72.    Regs.ah := $16;
  73.    Regs.ds := Seg(FCB);
  74.    Regs.dx := Ofs(FCB);
  75.    MsDos(Regs);
  76.    IF Regs.AL = 0 THEN
  77.       SetDiskID := TRUE
  78.    ELSE
  79.       SetDiskID := FALSE
  80. END;
  81.  
  82. {use MsDOS service 17H to RENAME a volume label }
  83. FUNCTION ReNameDiskID(Drive:DriveType;
  84.                    OldDiskID:DiskIDType ;
  85.                    NewDiskID:DiskIDType): Boolean;
  86. VAR
  87.    FCB  : ExtendedFCBRecord;
  88.    Regs : Registers;
  89.    Temp : String[1];
  90.    I    : Integer;
  91. BEGIN
  92.   Temp := Drive;
  93.   WITH FCB DO
  94.     BEGIN
  95.       ExtFCB := $FF;
  96.       Attr   := $8;
  97.       Drive  := Ord(UpCase(Temp[1])) - 64;
  98.  
  99.       {Set old disk id}
  100.  
  101.       FOR I := 1 TO Length(OldDiskID) DO
  102.         Name1[I] := OldDiskID[I];
  103.       FOR I := (Length(OldDiskID) + 1) TO 11 DO
  104.         Name1[I] := ' ';
  105.  
  106.       {Set new disk id}
  107.  
  108.       FOR I := 1 TO Length(NewDiskID) DO
  109.         Name2[I] := NewDiskID[I];
  110.       FOR I := (Length(NewDiskID) + 1) TO 11 DO
  111.         Name2[I] := ' '
  112.     END;
  113.   Regs.ah := $17;
  114.   Regs.ds := Seg(FCB);
  115.   Regs.dx := Ofs(FCB);
  116.   MsDos(Regs);
  117.   IF Regs.AL = 0 THEN
  118.      ReNameDiskID := TRUE
  119.   ELSE
  120.      ReNameDiskID := FALSE
  121. END;
  122.  
  123. {Use MsDos service 13H DELETE a volume label }
  124.  
  125. FUNCTION DeleteDiskID(Drive:DriveType): Boolean;
  126. VAR
  127.   FCB  : ExtendedFCBRecord;
  128.   Regs : Registers;
  129.   Temp : String[1];
  130.   I    : Integer;
  131. BEGIN
  132.   Temp := Drive;
  133.   WITH FCB DO
  134.     BEGIN
  135.       ExtFCB := $FF;
  136.       Attr   := $8;
  137.       Drive  := Ord(UpCase(Temp[1])) - 64;
  138.       Name1[1] := '*';
  139.       Name1[2] := '.';
  140.       Name1[3] := '*';
  141.       FOR I := 4 TO 11 DO Name1[I] := ' '
  142.     END;
  143.   Regs.ah := $13;
  144.   Regs.ds := Seg(FCB);
  145.   Regs.dx := Ofs(FCB);
  146.   MsDos(Regs);
  147.   IF Regs.AL = 0 THEN
  148.      DeleteDiskID := TRUE
  149.   ELSE
  150.      DeleteDiskID := FALSE
  151. END;
  152.  
  153. END.
  154.  
  155. { ---------------    TEST PROGRAM -------------------}
  156.  
  157.  
  158. PROGRAM TestFCB;
  159.  
  160. { test FCBLabel UNIT}
  161.  
  162. USES  CRT,FCBLabel;
  163.  
  164. VAR
  165.    Choice      : Byte;
  166.    Drive       : DriveType;
  167.    DiskID      : DiskIDType;
  168.    NewDiskID   : DiskIDType;
  169.  
  170. BEGIN
  171.   REPEAT {Endless loop - select option 5 to Exit}
  172.     ClrScr;
  173.     GotoXY(25,1);  WriteLn('Volume Functions');
  174.     GotoXY(25,9);  WriteLn('1) SET LABEL');
  175.     GotoXY(25,10); WriteLn('2) DELETE LABEL');
  176.     GotoXY(25,11); WriteLn('3) RENAME LABEL');
  177.     GotoXY(25,12); WriteLn('4) GET LABEL');
  178.     GotoXY(25,13); WriteLn('5) Exit');
  179.     GotoXY(20,15);
  180.     Write('Type number and press Enter > ');
  181.     ReadLn(Choice); WriteLn;
  182.     Drive := 'C';   { use drive C: as test drive }
  183.  
  184.     CASE Choice OF
  185.     1: BEGIN  {Set volume LABEL}
  186.         DiskID := GetDiskID(Drive);
  187.           IF DiskID <> '' THEN
  188.             BEGIN
  189.               WriteLn('Label not null: ',DiskID);
  190.               WriteLn('Use RENAME instead');
  191.               WriteLn('Press Enter to continue');
  192.               ReadLn
  193.             END
  194.           ELSE
  195.             BEGIN
  196.               Write('Enter new label > ');
  197.               ReadLn(DiskID);
  198.               IF NOT SetDiskID(Drive,DiskID) THEN
  199.                 BEGIN
  200.                   WriteLn('System Error');
  201.                   WriteLn
  202.                      ('Press Enter to continue');
  203.                   ReadLn
  204.                 END
  205.             END
  206.           END;
  207.      2: BEGIN {Delete Volume LABEL}
  208.           IF DeleteDiskID(Drive) THEN
  209.             WriteLn('Volume label deleted')
  210.           ELSE
  211.             WriteLn('System Error');
  212.           WriteLn('Press Enter to continue');
  213.           ReadLn
  214.         END;
  215.      3: BEGIN {Rename Volume LABEL}
  216.           DiskID := GetDiskID(Drive);
  217.           IF DiskID = '' THEN
  218.             BEGIN
  219.               WriteLn('Current label is null:');
  220.               WriteLn('Use SET option instead');
  221.               WriteLn('Press Enter to continue');
  222.               ReadLn
  223.             END
  224.           ELSE
  225.             BEGIN
  226.               Write('Enter new name of label > ');
  227.               ReadLn(NewDiskID);
  228.               IF NOT ReNameDiskID
  229.                      (Drive,DiskID,NewDiskID) THEN
  230.                 BEGIN
  231.                   WriteLn('System Error');
  232.                   WriteLn
  233.                      ('Press Enter to continue');
  234.                   ReadLn
  235.                 END
  236.             END
  237.         END;
  238.      4: BEGIN {Get Volume LABEL}
  239.           DiskID := GetDiskID(Drive);
  240.           Write('The current label is ');
  241.           IF DiskID = '' THEN
  242.             WriteLn('null')
  243.           ELSE
  244.             WriteLn(DiskID);
  245.             WriteLn('Press Enter to continue');
  246.             ReadLn
  247.         END;
  248.      5: Halt;
  249.      ELSE   { continue }
  250.     END     { case }
  251.   UNTIL FALSE
  252. END.
  253.